C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C ----------------------------------------------------------------------
C
C       I F B L K S   -   FORM BLOCK 'IF' STATEMENT FROM SIMPLE 'IF' FOR
C                         SEGMENT MONITORING
C
 
        SUBROUTINE IFBLKS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
 
        INTEGER ISEGL
 
        ISCNTG(ITYPEG) = ISCNTG(ITYPEG) + 1
        IF (SEGMTG) THEN
            CALL OUTSGS(NMSEG)
            ISEGL=NMSEG
            SEGMTG = .FALSE.
        ELSE
            ISEGL=0
        END IF
        CALL SEGMTS(.TRUE.)
        ISCNTG(ITYPEG) = ISCNTG(ITYPEG) - 1
C OUTPUT ANNOTATED STATEMENT
        CALL OUTIFS(ISEGL,NMSEG)
C SET UP BLOCK INSTRUMENTATION
        NBUFFG=0
        CALL SENDCH('     ')
        CALL UNLABL
        CALL SENDTK(1,NTOK2G)
        CALL SENDCH('THEN')
C OUTPUT 'IF' TEST AS 'IF-THEN' STATEMENT
        CALL SEND
C OUTPUT SEGMENT WITHIN 'IF-THEN' BLOCK
        CALL OUTSGS(NMSEG)
        IF (IFTYPG .EQ. KSTOPG) THEN
C OUTPUT CALL TO WRAPUP ROUTINE FOR 'IF-STOP'
            CALL OUTMSG('      CALL R'//VNAMEG,IODSCR)
            STOPG = .TRUE.
        ELSE
C OUTPUT NORMAL 'IF' CONSEQUENCE AS SINGLE STMT
            NBUFFG=0
            CALL SENDTK(NTOK2G+1,NTOKSS)
            CALL SEND
        END IF
C OUTPUT END OF 'IF' BLOCK
        CALL OUTMSG('      ENDIF',IODSCR)
 
        END
C ----------------------------------------------------------------------
C
C       I F D O S   -   SET UP TEST PORTION OF 'IF' WHICH ENDS A DO-LOOP
C                       ,USING A CALL TO A LOGICAL INSTRUMENTING ROUTINE
C
 
        SUBROUTINE IFDOS(ISEGA,JSEGA)
        INTEGER ISEGA,JSEGA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  ROUTINE INSTRUMENTATION FLAGS
      COMMON / INSTC   /    INST1G,      INST2G,      INST3G
 
        INTEGER INST1G,INST2G,INST3G
 
        SAVE /INSTC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        INTEGER L
 
C Set up first constants
        IFDOG = .TRUE.
        INST3G = 1
        IF (TOKTYP(1).EQ.TDCNST) THEN
            CALL SENDTK(1,1)
        ELSE
            CALL SENDCH('      ')
        END IF
        CALL SENDCH('IF(L'//VNAMEG)
C Send test portion of 'IF'
        CALL SENDTK(NTOKG,NTOK2G-1)
C Set up segment numbers
        CALL SENDCH(',')
        IF (ISEGA .EQ. 0) THEN
            CALL SENDCH('0')
        ELSE
C Send unconditional segment
            CALL SENDI(ISEGA)
        END IF
        CALL SENDCH(',')
        IF (JSEGA .EQ. 0) THEN
            CALL SENDCH('0')
        ELSE
C Send conditional segment
            CALL SENDI(JSEGA)
        END IF
        CALL SENDCH('))')
 
        END
C ----------------------------------------------------------------------
C
C       I F E N D S   -   SET UP 'IF' WHICH ENDS A DO-LOOP, AND OUTPUT
C                         STATEMENT.
C
 
        SUBROUTINE IFENDS(ISEGA,JSEGA)
        INTEGER ISEGA,JSEGA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
C FORM FIRST PART OF INSTRUMENTED 'IF'
        CALL IFDOS(ISEGA,JSEGA)
C FORM LAST PART OF INSTRUMENTED 'IF'.
        IF (IFTYPG .EQ. KSTOPG) THEN
C 'STOP' CONSEQUENCE. ADD CALL TO WRAPUP ROUTINE.
            STOPG = .TRUE.
            CALL SENDCH('CALLR'//VNAMEG)
        ELSE
C OTHER CONSEQUENCE. ADD CONSEQUENCE.
            CALL SENDTK(NTOK2G+1,NTOKSS)
        END IF
C OUTPUT INSTRUMENTED STATEMENT
        CALL SEND
C OUTPUT ANNOTATED STATEMENT
        CALL OUTIFS(ISEGA,JSEGA)
 
        END
C ----------------------------------------------------------------------
C
C       I N I T R S   -   INITIALISE ROUTINE-DEPENDENT VARIABLES
C
 
        SUBROUTINE INITRS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Dictionary
C   MAXDDG = Maximum number of dimension names in dictionary
C   MAXRDG = Maximum number of routine names in dictionary
        INTEGER MAXDDG,MAXRDG
        PARAMETER(MAXDDG=150,MAXRDG=250)
        COMMON /ANDICT/ DDICTG,RDICTG
        CHARACTER*6 DDICTG(MAXDDG),RDICTG(MAXRDG)
        SAVE /ANDICT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        CHARACTER*6 NAMEL
        INTEGER ITOK,I,ISEG1L,IASR1L
 
        EXTERNAL ZCHOUT,ZPTINT,PUTCH
 
C PICK UP POSSIBLE NAME
        NAMEL=' '
        IF (ITYPEG.EQ.KPROGG .OR. ITYPEG.EQ.KBLOKG .OR.
     +      ITYPEG.EQ.KSUBRG .OR. ITYPEG.EQ.KUFUNG .OR.
     +      ITYPEG.EQ.KCFUNG .OR. ITYPEG.EQ.KXFUNG .OR.
     +      ITYPEG.EQ.KDFUNG .OR. ITYPEG.EQ.KIFUNG .OR.
     +      ITYPEG.EQ.KRFUNG .OR. ITYPEG.EQ.KLFUNG) THEN
            ITOK=1
 100        ITOK=ITOK+1
            IF (TOKTYP(ITOK).NE.TNAME .AND. ITOK.LT.NTOKSS) GOTO 100
            IF (TOKTYP(ITOK).EQ.TNAME)
     +          CALL ZITOF(ISTTXT(ISTPTR(ITOK)),1,6,NAMEL,.FALSE.)
        END IF
C INITIALISE BY ROUTINE TYPE
        IF (ITYPEG.EQ.KBLOKG) THEN
C BLOCK DATA ROUTINE
            BLKDTG = .TRUE.
            IASR1L = 0
            ISEG1L = 0
            INSRTG = .TRUE.
            MAING = .FALSE.
            IF (NAMEL.NE.' ') THEN
                NAMEG = NAMEL
            ELSE
                NAMEG = 'BLKDTA'
            END IF
        ELSE
C NON-BLOCK DATA ROUTINE
            BLKDTG = .FALSE.
            EXECG = .FALSE.
            INSRTG = .FALSE.
            IERRG = 0
            JERRG = 0
            KERRG = 0
            LABFLG = 0
            NEDICG = 0
            NDDICG = 0
            NLABG = 0
            SEGMTG = .FALSE.
            CALL SEGMTS(.FALSE.)
            IASR1L = NMASRG + 1
            ISEG1L = NMSEG
            IF (ITYPEG.EQ.KPROGG) THEN
C MAIN PROGRAM WITH PROGRAM CARD
                MAING = .TRUE.
                NAMEG = NAMEL
            ELSE IF (ITYPEG.EQ.KSUBRG .OR. ITYPEG.EQ.KUFUNG .OR.
     +               ITYPEG.EQ.KCFUNG .OR. ITYPEG.EQ.KXFUNG .OR.
     +               ITYPEG.EQ.KDFUNG .OR. ITYPEG.EQ.KIFUNG .OR.
     *               ITYPEG.EQ.KLFUNG .OR. ITYPEG.EQ.KRFUNG) THEN
C SUBROUTINE OR FUNCTION
                MAING = .FALSE.
                NAMEG = NAMEL
                CALL DARGS
            ELSE
C MAIN PROGRAM WITHOUT PROGRAM CARD
                MAING = .TRUE.
                NAMEG = 'MAIN'
            END IF
C SAVE ROUTINE NAME FOR PROGRAM CALL TREE
            CALL NSAVES(NAMEG,RDICTG,NRDICG,MAXRDG,NCRTNG)
C IF ROUTINE DICTIONARY OVERFLOW, STOP NOW.
            IF (NCRTNG.EQ.0) CALL ERRORS(14)
C SAVE ROUTINE STATS FOR INSTRUMENTED PROGRAM
            NRTNG = NRTNG + 1
            IABEG(NRTNG) = IASR1L
            ISBEG(NRTNG) = ISEG1L
            ICRTNG(NRTNG) = NCRTNG
        END IF
C OUTPUT FIRST STATEMENT TYPE SUMMARY FILE RECORD
C FOR ROUTINE
        CALL ZCHOUT(NAMEG//'.',IODSTS)
        CALL PUTCH(32,IODSTS)
        CALL ZPTINT(ISEG1L,1,IODSTS)
        CALL PUTCH(32,IODSTS)
        CALL ZPTINT(IASR1L,1,IODSTS)
        CALL PUTCH(10,IODSTS)
 
        END
C ----------------------------------------------------------------------
C
C       I N I T S S   -   INITIALIZE SYSTEM VARIABLES
C
 
      SUBROUTINE INITSS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  ROUTINE INSTRUMENTATION FLAGS
      COMMON / INSTC   /    INST1G,      INST2G,      INST3G
 
        INTEGER INST1G,INST2G,INST3G
 
        SAVE /INSTC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
 
        INTEGER L
 
C SET UP KEYWORDS
        CALL KEYS
C ZERO STATIC COUNTS
        DO 100 L=1,NTYPEG
            IPCNTG(L) = 0
            IRCNTG(L) = 0
  100       ISCNTG(L) = 0
 
        ARITHG = .FALSE.
        BLKDTG = .FALSE.
        CARD1G = .FALSE.
        CGOTOG = .FALSE.
        ENTRYG = .FALSE.
        EXECG = .FALSE.
        IFDOG = .FALSE.
        INST1G = 0
        INST2G = 0
        INST3G = 0
        ITYPEG = KENDG
        LINEG = 50
        LTYPEG = KENDG
        MAING = .TRUE.
        NEDICG = 0
        NDDICG = 0
        NLABG = 0
        NMASRG = 0
        NMSEG = 0
        NRDICG = 0
        NRTNG = 0
        NTREEG = 0
        STOPG = .FALSE.
        TREEG = .TRUE.
 
      END
C ----------------------------------------------------------------------
C
C       I N S R T S   -   INSERT MARKER IN SCRATCH INSTRUMENTATION FILE
C                         INDICATING SPOT FOR INSERTION OF COMMON
C                         BLOCKS FOR EACH ROUTINE.
C
 
        SUBROUTINE INSRTS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
 
        EXTERNAL ZCHOUT,ZPTINT,PUTCH
 
        IF (ITYPEG.NE.KPROGG .AND. ITYPEG.NE.KSUBRG .AND.
     +      ITYPEG.NE.KCFUNG .AND. ITYPEG.NE.KXFUNG .AND.
     +      ITYPEG.NE.KDFUNG .AND. ITYPEG.NE.KIFUNG .AND.
     +      ITYPEG.NE.KLFUNG .AND. ITYPEG.NE.KRFUNG .AND.
     +      ITYPEG.NE.KUFUNG .AND. ITYPEG.NE.KFORMG .AND.
     +      ITYPEG.NE.KNTRYG .AND. ITYPEG.NE.KPARAG .AND.
     +      ITYPEG.NE.KIMPLG) THEN
C INSERT MONITORING COMMON BLOCKS IN FIRST SPOT
C FOLLOWING PROGRAM, SUBROUTINE, FUNCTION,
C PARAMETER AND IMPLICIT STATEMENTS.
            CALL ZCHOUT('$ ',IODSCR)
            CALL ZPTINT(NCRTNG,1,IODSCR)
            CALL PUTCH(10,IODSCR)
            INSRTG = .TRUE.
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       K E Y S   -   INITIALIZE SYSTEM STATEMENT TYPE DIRECTORY.
C                     KEYWORDS ARE ORDERED AND USED FOR RECOGNITION
C                     PURPOSES. OTHER DIRECTORY CODES ARE USED FOR
C                     STATIC AND DYNAMIC COUNTS, AND CREATE
C                     ADDITIONAL TYPES WHICH HAVE NO ASSOCIATED
C                     KEYWORD.
C                       - NO BLANKS IN KEYWORDS
C                       - ORDER SIMILAR KEYWORDS WITH LONGER ONE FIRST.
C                       - USE BLANKS TO ESTABLISH NON-KEYWORD.
C                         ORDER NOT SIGNIFICANT FOR NON-KEYWORDS.
C                       - ORDER DOES NOT IMPLY ORDER OF ANY OUTPUT
C                         REPORTS, WHICH ARE FORMATTED SEPARATELY.
C
 
        SUBROUTINE KEYS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
 
        INTEGER I
 
        NTYPEG=0
        DO 100 I=1,81
 100        KTOKG(I)=KNONEG
 
C ASSIGN
        CALL LOADTS(1,KASSNG)
        KTOKG(TASSIG)=KASSNG
C BACKSPACE
        CALL LOADTS(1,KBACKG)
        KTOKG(TBACKS)=KBACKG
C BLOCKDATA
        CALL LOADTS(0,KBLOKG)
        KTOKG(TBLOCK)=KBLOKG
C CALL
        CALL LOADTS(1,KCALLG)
        KTOKG(TCALL)=KCALLG
C CHARACTER FUNCTION
        CALL LOADTS(0,KCFUNG)
C CHARACTER
        CALL LOADTS(0,KCHARG)
        KTOKG(TCHARA)=KCHARG
C CLOSE
        CALL LOADTS(1,KCLOSG)
        KTOKG(TCLOSE)=KCLOSG
C COMMON
        CALL LOADTS(0,KCOMNG)
        KTOKG(TCOMMO)=KCOMNG
C COMPLEX FUNCTION
        CALL LOADTS(0,KXFUNG)
C COMPLEX
        CALL LOADTS(0,KCMPXG)
        KTOKG(TCOMPL)=KCMPXG
C DOUBLE COMPLEX treated as COMPLEX
        KTOKG(TDCMPL)=KCMPXG
C CONTINUE
        CALL LOADTS(1,KCONTG)
        KTOKG(TCONTI)=KCONTG
C DATA
        CALL LOADTS(0,KDATAG)
        KTOKG(TDATA)=KDATAG
C DIMENSION
        CALL LOADTS(0,KDIMNG)
        KTOKG(TDIMEN)=KDIMNG
C DOUBLEPRECISIONFUNCTION
        CALL LOADTS(0,KDFUNG)
C DOUBLEPRECISION
        CALL LOADTS(0,KDBLEG)
        KTOKG(TDOUBL)=KDBLEG
C DO
        CALL LOADTS(1,KDOG)
        KTOKG(TDO)=KDOG
C ELSEIF(
        CALL LOADTS(1,KELSFG)
        KTOKG(TELSIF)=KELSFG
C ELSE
        CALL LOADTS(1,KELSEG)
        KTOKG(TELSE)=KELSEG
C ENDFILE
        CALL LOADTS(1,KENDFG)
        KTOKG(TENDFI)=KENDFG
C ENDIF
        CALL LOADTS(1,KENDIG)
        KTOKG(TENDIF)=KENDIG
C END
        CALL LOADTS(1,KENDG)
        KTOKG(TEND)=KENDG
C ENTRY
        CALL LOADTS(0,KNTRYG)
        KTOKG(TENTRY)=KNTRYG
C EQUIVALENCE
        CALL LOADTS(0,KEQIVG)
        KTOKG(TEQUIV)=KEQIVG
C EXTERNAL
        CALL LOADTS(0,KEXTLG)
        KTOKG(TEXTER)=KEXTLG
C FORMAT
        CALL LOADTS(0,KFORMG)
        KTOKG(TFORMA)=KFORMG
C FUNCTION
        CALL LOADTS(0,KUFUNG)
        KTOKG(TFUNCT)=KUFUNG
C GOTO
        CALL LOADTS(1,KUGOG)
        KTOKG(TGOTO)=KUGOG
C IF(
        CALL LOADTS(1,KLIFG)
        KTOKG(TIF)=KLIFG
C IMPLICIT
        CALL LOADTS(0,KIMPLG)
        KTOKG(TIMPLI)=KIMPLG
C INQUIRE
        CALL LOADTS(1,KINQRG)
        KTOKG(TINQUI)=KINQRG
C INTEGER FUNCTION
        CALL LOADTS(0,KIFUNG)
C INTEGER
        CALL LOADTS(0,KINTEG)
        KTOKG(TINTEG)=KINTEG
C INTRINSIC
        CALL LOADTS(0,KINSCG)
        KTOKG(TINTRI)=KINSCG
C LOGICAL FUNCTION
        CALL LOADTS(0,KLFUNG)
C LOGICAL
        CALL LOADTS(0,KLOGCG)
        KTOKG(TLOGIC)=KLOGCG
C OPEN
        CALL LOADTS(1,KOPENG)
        KTOKG(TOPEN)=KOPENG
C PARAMETER
        CALL LOADTS(0,KPARAG)
        KTOKG(TPARAM)=KPARAG
C PAUSE
        CALL LOADTS(1,KPAUSG)
        KTOKG(TPAUSE)=KPAUSG
C PRINT
        CALL LOADTS(1,KPRNTG)
        KTOKG(TPRINT)=KPRNTG
C PROGRAM
        CALL LOADTS(0,KPROGG)
        KTOKG(TPROGR)=KPROGG
C READ
        CALL LOADTS(1,KREADG)
        KTOKG(TREAD)=KREADG
C REAL FUNCTION
        CALL LOADTS(0,KRFUNG)
C REAL
        CALL LOADTS(0,KREALG)
        KTOKG(TREAL)=KREALG
C RETURN
        CALL LOADTS(1,KRETNG)
        KTOKG(TRETUR)=KRETNG
C REWIND
        CALL LOADTS(1,KWINDG)
        KTOKG(TREWIN)=KWINDG
C SAVE
        CALL LOADTS(0,KSAVEG)
        KTOKG(TSAVE)=KSAVEG
C STOP
        CALL LOADTS(1,KSTOPG)
        KTOKG(TSTOP)=KSTOPG
C SUBROUTINE
        CALL LOADTS(0,KSUBRG)
        KTOKG(TSUBRO)=KSUBRG
C WRITE
        CALL LOADTS(1,KWRITG)
        KTOKG(TWRITE)=KWRITG
C ASSIGNED GOTO
        CALL LOADTS(1,KAGOG)
C COMPUTED GOTO
        CALL LOADTS(1,KCGOG)
C ARITHMETIC IF
        CALL LOADTS(1,KAIFG)
C BLOCK IF (IF...THEN)
        CALL LOADTS(1,KBIFG)
C ASSIGNMENT STATEMENTS (A = B)
        CALL LOADTS(1,KASMTG)
        KTOKG(TNAME)=KASMTG
C STATEMENT FUNCTION STATEMENTS
        CALL LOADTS(0,KSFUNG)
C UNRECOGNIZED STATEMENTS
        CALL LOADTS(1,KNONEG)
C ASSERTIONS
        CALL LOADTS(1,LASRTG)
C COMMENTS
        CALL LOADTS(0,LCMNTG)
C ERRORS IN SOURCE CODE
        CALL LOADTS(0,LERRG)
C LINES OF SOURCE CODE
        CALL LOADTS(0,LLINEG)
C STATEMENTS OF SOURCE CODE
        CALL LOADTS(0,LSTMTG)
*$AS$ (NTYPEG.LE.75)
 
        END
C ----------------------------------------------------------------------
C
C       L A B C K S   -   LOOK FOR AND TYPE STATEMENT LABEL FOR
C                         THIS EXECUTABLE STATEMENT
C
 
        SUBROUTINE LABCKS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        INTEGER L,KL,LABEL
 
        INTEGER CTOI
        EXTERNAL CTOI
 
        LABEL=0
        IF (TOKTYP(1).EQ.TDCNST) THEN
            L=1
            LABEL=CTOI(ISTTXT(ISTPTR(1)),L)
C LABEL FOUND. SEE IF STATEMENT ENDS A *DO* LOOP
            IF (NLABG .EQ. MAXLBG) THEN
C DO-LABEL STORAGE FULL. ASSUME THIS LABEL ENDS *DO*.
                LABFLG = 2
                CALL SEGMTS(.TRUE.)
            ELSE
                IF (NLABG.GT.0) THEN
                    DO 110 L=1,NLABG
                        IF (LABEL.NE.LABG(1,L)) GO TO 110
C LABEL ENDS *DO* LOOP
                        LABFLG = 2
C IF LOOP ACTIVE, LOOP-END IS A SEGMENT
                       IF (NMSEG.GT.LABG(2,L)) CALL SEGMTS(.TRUE.)
C REDUCE LABEL ARRAY
                       IF (NLABG.GT.L) THEN
                           DO 100 KL=L+1,NLABG
                               LABG(1,KL-1) = LABG(1,KL)
  100                      LABG(2,KL-1) = LABG(2,KL)
                       END IF
                       NLABG = NLABG - 1
                       GO TO 120
  110              CONTINUE
                END IF
C LABEL DOES NOT END *DO* LOOP
                LABFLG = 1
                CALL SEGMTS(.TRUE.)
            END IF
        ELSE
C NO LABEL FOUND
            LABFLG = 0
        END IF
*$AS$ (SEGMTG .OR. LABFLG.EQ.0 .OR. KEXECG(ITYPEG).EQ.0)
  120   RETURN
 
        END
